home *** CD-ROM | disk | FTP | other *** search
/ SGI Developer Toolbox 6.1 / SGI Developer Toolbox 6.1 - Disc 4.iso / src / swtools / trubasic / rolldemos / demos / rgb / xdance.tru < prev   
Text File  |  1994-08-02  |  3KB  |  158 lines
  1. ! True BASIC - Demo for Silicon Graphics
  2. ! uses doublebuffering and rgb-mode Gourard shading
  3. ! dance of the sugar plum polygons
  4.  
  5. ! NOTE: adjustments for X windows.  checks mode after setting it to see
  6. ! if doublebuffering is supported.  then lowers increment for loops
  7. ! since animation is not as smooth and waits after each frame is shown.
  8.  
  9. CALL tw_wset_size(0,750,750)
  10. call tw_wset_title(0,"xdance")
  11. dim pts2(5,2), clrs2(5)
  12. randomize
  13.  
  14. set mode "doublebuffer"
  15. ask mode m$
  16. if m$<>"DOUBLEBUFFER" then
  17.     let buffers=0
  18.     print "doublebuffering not supported"
  19.     pause 1
  20. else
  21.       let buffers=1
  22. end if
  23. set mode "rgb"
  24.  
  25. ! use whole screen
  26. open #1: screen 0,1,0,1
  27.  
  28. ! set coordinate system
  29. set window -1,1,-1,1
  30.  
  31. clear
  32. call swapbuffers(1)
  33. set text justify "center","bottom"
  34. let clr=-1
  35.  
  36. let n=setfont("Courier")
  37. let n=setfontsize(18)
  38. let n=setfontstyle("BoldOblique")
  39.  
  40. ! use polygons with an increasing number of sides
  41. when error in
  42. let sides=2
  43. do
  44.  
  45.    ! determine vertices and colors for polygon
  46.    let sides=sides+1
  47.    call tbgon(sides)
  48.  
  49.    ! come forward 
  50.    if buffers=0 then
  51.     let inc=.05
  52.    else
  53.     let inc=.01
  54.    end if
  55.    for i=0 to .5 step inc
  56.     clear
  57.     draw hexagon with scale(i,i)*rotate(i*10)
  58.     call swapbuffers(1)
  59.     if buffers=0 then call wait
  60.    next i
  61.    pause 1
  62.  
  63.    ! break apart and come together
  64.    for i=0 to 1 step inc
  65.     clear
  66.     draw logo
  67.     draw hexagon with scale(.5,.5)*shift(-i,i)
  68.     draw hexagon with scale(.5,.5)*shift(i,i)
  69.     draw hexagon with scale(.5,.5)*shift(-i,-i)
  70.     draw hexagon with scale(.5,.5)*shift(i,-i)
  71.     draw hexagon with scale(.5,.5)*shift(-i,i)*rotate(i)
  72.     draw hexagon with scale(.5,.5)*shift(i,i)*rotate(i*2)
  73.     draw hexagon with scale(.5,.5)*shift(-i,-i)*rotate(i*4)
  74.     draw hexagon with scale(.5,.5)*shift(i,-i)*rotate(i*8)
  75.     call swapbuffers(1)
  76.     if buffers=0 then call wait
  77.    next i
  78.    for i=1 to -.01 step -inc
  79.     clear
  80.     draw logo
  81.     draw hexagon with scale(.5,.5)*shift(-i,i)
  82.     draw hexagon with scale(.5,.5)*shift(i,i)
  83.     draw hexagon with scale(.5,.5)*shift(-i,-i)
  84.     draw hexagon with scale(.5,.5)*shift(i,-i)
  85.     draw hexagon with scale(.5,.5)*shift(-i,i)*rotate(i)
  86.     draw hexagon with scale(.5,.5)*shift(i,i)*rotate(i*2)
  87.     draw hexagon with scale(.5,.5)*shift(-i,-i)*rotate(i*4)
  88.     draw hexagon with scale(.5,.5)*shift(i,-i)*rotate(i*8)
  89.     call swapbuffers(1)
  90.     if buffers=0 then call wait
  91.    next i
  92.    pause 1
  93.  
  94.    ! retreat
  95.    for i=.5 to 0 step -inc
  96.     clear
  97.     draw hexagon with scale(i,i)*rotate(i*10)
  98.     call swapbuffers(1)
  99.     if buffers=0 then call wait
  100.    next i
  101. loop
  102. use
  103.   ! print error if it occurs
  104.   set mode "text"
  105.   print extext$,exline$
  106. end when
  107.  
  108. PICTURE hexagon
  109.     call gshade(pts2,clrs2)
  110. END PICTURE
  111.  
  112. sub wait
  113.     for w=1 to 10000
  114.         let tmp=sin(w)*cos(w)
  115.         let tmp=tmp*sin(w)*cos(w)
  116.     next w
  117. end sub
  118.  
  119. ! determine vertices and colors for a polygon of n sides
  120. sub tbgon(n)
  121.    mat redim pts2(n+1,2)
  122.    mat redim clrs2(n+1)
  123.  
  124.    when error in
  125.      ! determine colors to use
  126.      let clr=int(rnd*6)
  127.  
  128.      for i=0 to n-1
  129.         let x=cos(i*2*pi/n-1)
  130.         let y=sin(i*2*pi/n-1)
  131.     let pts2(i+1,1)=x
  132.     let pts2(i+1,2)=y
  133.     let clrs2(i+1)=mod(i,2)+clr
  134.      next i
  135.      let x=cos(i*2*3.14159/n-1)
  136.      let y=sin(i*2*3.14159/n-1)
  137.      let pts2(i+1,1)=x
  138.      let pts2(i+1,2)=y
  139.      let clrs2(i+1)=mod(i,2)+clr
  140. use
  141.    set mode "text"
  142.    print extext$,exline$
  143. end when
  144. end sub
  145.  
  146. PICTURE logo
  147.    set color clr+1  
  148.    box area -.23,.23,-.03,.08
  149.    set color clr  
  150.    box area -.22,.22,-.02,.07
  151.    set color 15    ! bright white 
  152.    plot text, at 0,0: "True BASIC"
  153. END PICTURE
  154.  
  155. get key k
  156. end
  157.  
  158.